Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH8/SRC/FLAKEAN1.FRM

Visual Basic Form | 1996-05-02 | 7.6 KB | 268 lines

VERSION 4.00
Begin VB.Form FlakeForm
   Caption         =   "Snowflake"
   ClientHeight    =   4365
   ClientLeft      =   2280
   ClientTop       =   1185
   ClientWidth     =   5070
   Height          =   5055
   Left            =   2220
   LinkTopic       =   "Form1"
   ScaleHeight     =   291
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   338
   Top             =   555
   Width           =   5190
   Begin VB.TextBox ThetaText
      Height          =   285
      Left            =   600
      MaxLength       =   3
      TabIndex        =   1
      Text            =   "60"
      Top             =   360
      Width           =   375
   End
   Begin VB.TextBox LevelText
      Height          =   285
      Left            =   600
      MaxLength       =   3
      TabIndex        =   0
      Text            =   "4"
      Top             =   0
      Width           =   375
   End
   Begin VB.PictureBox Canvas
      AutoRedraw      =   -1  'True
      Height          =   4335
      Left            =   1080
      ScaleHeight     =   285
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   261
      TabIndex        =   4
      Top             =   0
      Width           =   3975
   End
   Begin VB.CommandButton CmdGo
      Caption         =   "Go"
      Default         =   -1  'True
      Height          =   495
      Left            =   120
      TabIndex        =   2
      Top             =   840
      Width           =   735
   End
   Begin VB.Label Label1
      Caption         =   "Theta"
      Height          =   255
      Index           =   1
      Left            =   0
      TabIndex        =   5
      Top             =   360
      Width           =   495
   End
   Begin VB.Label Label1
      Caption         =   "Level"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   495
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
Attribute VB_Name = "FlakeForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Const PI = 3.14159
Dim TheLevel As Integer
Dim StartLength As Integer
' Coordinates of the points in the initiator.
Const NumIni = 3
Dim IniX(0 To NumIni) As Single
Dim IniY(0 To NumIni) As Single
' Angles and distances for the generator.
Const NumGen = 4
Dim DistFactor As Single
Dim GenDTheta(1 To NumGen) As Single
Sub GetParameters()
Dim theta As Single
    If Not IsNumeric(LevelText.Text) Then _
        LevelText.Text = "5"
    TheLevel = CInt(LevelText.Text)
    ' Initialize the generator.
    If Not IsNumeric(ThetaText.Text) Then _
        ThetaText.Text = "60"
    theta = CInt(ThetaText.Text) / 180 * PI
    DistFactor = 1 / (2 * (1 + Cos(theta)))
    GenDTheta(1) = 0
    GenDTheta(2) = theta
    GenDTheta(3) = -2 * theta
    GenDTheta(4) = theta
End Sub
' ************************************************
' Recursively draw a snowflake edge starting at
' (x1, y1) in direction theta and distance dist.
' Leave the coordinates of the endpoint in
' (x1, y1).
' ************************************************
Sub DrawFlakeEdge(level As Integer, x1 As Single, y1 As Single, ByVal theta As Single, ByVal dist As Single, offset As Single)
Dim status As Integer
Dim i As Integer
Dim x2 As Single
Dim y2 As Single
Dim new_theta As Single
Dim dtheta As Single
Dim hyp As Single
Dim adj As Single
    If level <= 1 Then
        ' Draw the final level.
        dist = dist * DistFactor
        adj = dist * Cos(GenDTheta(2))
        hyp = Sqr(adj * adj + offset * offset)
        x2 = x1 + dist * Cos(theta)
        y2 = y1 + dist * Sin(theta)
        Canvas.Line (x1, y1)-(x2, y2)
        x1 = x2
        y1 = y2

        dtheta = Arctan2(adj, offset)
        new_theta = theta + dtheta
        x2 = x1 + hyp * Cos(new_theta)
        y2 = y1 + hyp * Sin(new_theta)
        Canvas.Line (x1, y1)-(x2, y2)
        x1 = x2
        y1 = y2

        new_theta = theta - dtheta
        x2 = x1 + hyp * Cos(new_theta)
        y2 = y1 + hyp * Sin(new_theta)
        Canvas.Line (x1, y1)-(x2, y2)
        x1 = x2
        y1 = y2

        x2 = x1 + dist * Cos(theta)
        y2 = y1 + dist * Sin(theta)
        Canvas.Line (x1, y1)-(x2, y2)
        x1 = x2
        y1 = y2

        Exit Sub
    End If
    ' Recursively draw the edge.
    dist = dist * DistFactor
    For i = 1 To NumGen
        theta = theta + GenDTheta(i)
        DrawFlakeEdge level - 1, x1, y1, theta, dist, offset
    Next i
End Sub
' ************************************************
' Draw the complete snowflake.
' ************************************************
Private Sub DrawFlake(level As Integer, offset As Single)
Dim i As Integer
Dim x1 As Single
Dim y1 As Single
Dim x2 As Single
Dim y2 As Single
Dim dx As Single
Dim dy As Single
Dim theta As Single
    Canvas.Cls
    ' Draw the snowflake.
    For i = 1 To NumIni
        x1 = IniX(i - 1)
        y1 = IniY(i - 1)
        x2 = IniX(i)
        y2 = IniY(i)
        dx = x2 - x1
        dy = y2 - y1
        theta = Arctan2(dx, dy)
        DrawFlakeEdge level, x1, y1, _
            theta, StartLength, offset
    Next i
End Sub
' ************************************************
' Play the movie.
' ************************************************
Private Sub CmdGo_Click()
    MakeMovie False
End Sub
Private Sub Form_Resize()
Dim unit As Single
Dim vunit As Single
Dim hunit As Single
Dim xmid As Single
Dim ymid As Single
    Canvas.Move Canvas.Left, 0, _
        ScaleWidth - Canvas.Left, ScaleHeight - 1
    ' See how big we can make the curve.
    vunit = 0.9 * Canvas.ScaleHeight / (Sqr(3) * 4 / 3)
    hunit = 0.9 * Canvas.ScaleWidth / 2
    If vunit < hunit Then
        unit = vunit
    Else
        unit = hunit
    End If
    StartLength = 2 * unit
    ' Initialize the initiator's coordinates.
    xmid = Canvas.ScaleWidth / 2
    ymid = Canvas.ScaleHeight / 2
    IniX(1) = xmid + unit
    IniY(1) = ymid - unit * Sqr(3) / 3
    IniX(2) = xmid - unit
    IniY(2) = IniY(1)
    IniX(3) = xmid
    IniY(3) = ymid + unit * Sqr(3) * 2 / 3
    IniX(0) = IniX(3)
    IniY(0) = IniY(3)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    End
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub
' ************************************************
' Make a series of images.
' ************************************************
Private Sub MakeMovie(to_file As Boolean)
Const FRAMES_PER_LEVEL = 20
Const FPS = 20
Dim frame As Integer
Dim i As Integer
Dim offset As Single
Dim doffset As Single
Dim level As Integer
Dim max_level As Integer
Dim next_time As Long
Dim mspf As Long
    MousePointer = vbHourglass
    GetParameters
    max_level = TheLevel
    ' Start cranking out frames.
    frame = 0
    mspf = 1000 \ FPS   ' Milliseconds per frame.
    next_time = GetTickCount()
    For level = 1 To max_level
        doffset = StartLength * DistFactor ^ level * _
            Sin(GenDTheta(2)) / FRAMES_PER_LEVEL
        offset = doffset

        For i = 1 To FRAMES_PER_LEVEL
            WaitTill next_time
            DrawFlake level, offset
            offset = offset + doffset
            DoEvents
            next_time = next_time + mspf
        Next i
        frame = frame + 1
    Next level
    MousePointer = vbDefault
End Sub